/*
 * Funny Language - a free style programming language.
 * Copyright (C) 2015 by fanguangping (fanguangping@163.com)
 * operator.c
 */

#include <stdio.h>
#include <stdlib.h>
#include <memory.h>
#include "memory.h"
#include "operator.h"

#define BLOCK_SIZE 256


// call/cc
// http://pathtovoid.net/post/2011/12/18/callcc-in-scheme/

Cell* eval(Scheme *sc, char* statement) {
	sc->op = cell_op_toplevel;
	sc->input = statement;
	sc->inputPointer = 0;
	Cell* operator = NULL;
	Cell* result = NULL;
	OperatorFunc func = NULL;

	while (TRUE) {
		operator = sc->op;
		//log_cell(sc, operator);
		func = operator->_op;
		result = func(sc);
        //debug(sc);
        //log_cell(sc, result);
		if (sc->returnValue != NULL && type_of(sc, sc->returnValue, EXCEPTION_TYPE)) {
			// exception handle
			sc->args = G_NIL;
			sc->args = cons(sc, second(sc->returnValue), sc->args);
			sc->args = cons(sc, first(sc->returnValue), sc->args);
			func = third(sc->returnValue)->_op;
			result = func(sc);
		}
		//if (type_of(sc, result, EXCEPTION_TYPE)) {
			// exception handle
			// func = find_property_of_object(sc, result, "handler")->_op;
			// result = func(sc);
		//}
		if (result == G_NIL)
			return sc->returnValue;
	}
}

/*
static int is_internal_operator(char *name) {
	if (name == NULL || *name == '$')
		return TRUE;
	return FALSE;
}
*/

/*
static void iterator(void *key, void *value, void *user_data) {
	char *name = (char *)key;
	OperatorFunc func = (OperatorFunc)value;
	Scheme *sc = (Scheme *)user_data;

	if (!is_internal_operator(name))
		new_slot_in_env(sc, make_symbol(sc, name), make_procedure(sc, func));
}
*/

//符号列表初始化
/*
static Cell* oblist_initial_value(Scheme *sc) {
	return make_vector(sc, 461); // probably should be bigger
}
*/

Cell* make_variable(Scheme *sc, const char *name) {
    Cell* variable = make_cell(sc, G_NIL, G_NIL);
    set_pointer(variable);
	variable->_type = POINTER;
	variable->_name = name;
    return variable;
}

Cell* make_constant(Scheme *sc, const char *name) {
	Cell* constant = make_cell(sc, G_NIL, G_NIL);
	set_pointer(constant);
	set_immutable(constant);
	constant->_type = POINTER;
	constant->_name = name;
	return constant;
}

int free_pointer(Cell *pointer) {
	if (pointer->_type == NULL) {
		return FALSE;
	}
	return strcmp(pointer->_type, POINTER) == 0;
}

/*
Cell* make_constant(Scheme *sc, const char *name, const char *type) {
    Cell* var = make_variable(sc, name, type);
    set_immutable(var);
    return var;
}
*/

void add_constant(Scheme *sc, const char *name, Cell *value) {
	//Cell* sym = make_symbol(sc, name);
    define_global_constant(sc, name, value);
	//new_slot_in_env(sc, sym, value);
	//add_slot_by_symbol(sc, sc->globalObjects, sym, value);
}

/*
void add_syntax(Scheme *sc, const char *name, Cell *value) {
    //Cell* sym = make_symbol(sc, name);
    define_global_constant(sc, name, value);
	//new_slot_in_env(sc, sym, value);
	//add_slot_by_symbol(sc, sc->globalObjects, sym, value);
}
*/

void add_operator(Scheme *sc, const char *name, OperatorFunc func) {
	Cell* cell = make_procedure(sc, name, func);
	add_constant(sc, name, cell);
}

void init_global_symbols(Scheme *sc) {
	;
}
void init_global_syntaxes(Scheme *sc) {
	init_read_operators(sc);
	init_write_operators(sc);
	init_control_operators(sc);
	init_define_operators(sc);
	init_eval_operators(sc);
	init_let_operators(sc);
	init_logic_operators(sc);
}
void init_global_operators(Scheme *sc) {
	init_atom_operators(sc);
	init_boolean_operators(sc);
	init_character_operators(sc);
	init_complex_operators(sc);
	init_decimal_operators(sc);
	init_fraction_operators(sc);
	init_integer_operators(sc);
	init_number_operators(sc);
	init_real_operators(sc);
	init_symbol_operators(sc);
	init_string_operators(sc);

	//init_syntaxes(sc);

	init_class_operators(sc);
	init_closure_operators(sc);
	init_continuation_operators(sc);
	//init_environment_operators(sc);
	init_exception_operators(sc);
	init_list_operators(sc);

	//init_object_operators(sc);
	init_pair_operators(sc);
	init_procedure_operators(sc);
	init_promise_operators(sc);
	init_vector_operators(sc);
}
void init_global_constants(Scheme *sc) {
	add_constant(sc, CONSTANT_NAME_NIL, G_NIL);
	init_boolean_constants(sc);
	//init_double_constants(sc);
	init_symbol_constants(sc);
	init_exception_constants(sc);
}

int scheme_init(Scheme *sc) {
	init_constants();
	init_class_hierarchy(sc);

	sc->lastCellSeg = -1;
	sc->freeCell = G_NIL;
	sc->freeCellCount = 0;
	alloc_cellseg(sc, 3);

	sc->code = G_NIL;
	sc->callStack = G_NIL;
	//sc->globalObjects = make_vector(sc, 461); /* probably should be bigger */
    sc->symbols = make_vector(sc, SYMBOL_POOL_SIZE);
	/* init global_env */
	//new_frame_in_env(sc, G_NIL);
	Cell* frame = make_vector(sc, DEFAULT_FRAME_SIZE);
	extend_environment(sc, frame, G_NIL);
	sc->globalEnv = sc->env;

	init_global_symbols(sc);
	init_global_syntaxes(sc);
	init_global_operators(sc);
	init_global_constants(sc);

	//init_system_operators(operators);
	//init_command_operators(operators);

	//cell_symbol_lambda = make_symbol(sc, "lambda");
	//cell_symbol_quote = make_symbol(sc, "quote");
	//cell_symbol_this = make_symbol(sc, "this");
	//cell_symbol_feed_to = make_symbol(sc, "=>");

	return TRUE;
}

void debug(Scheme *sc) {
	if (sc->op != NULL) {
		sc->opString = cell2str(sc, sc->op);
	}
	if (sc->args != NULL) {
		sc->argsString = cell2str(sc, sc->args);
	}
	if (sc->env != NULL) {
		sc->envString = cell2str(sc, sc->env);
	}
	if (sc->code != NULL) {
		sc->codeString = cell2str(sc, sc->code);
	}
	if (sc->returnValue != NULL) {
		sc->returnValueString = cell2str(sc, sc->returnValue);
	}
}

static char* concatenate(char* str, char* append) {
	if (append == NULL || strcmp(append, "") == 0) {
		return str;
	}
	int length = strlen(str) + strlen(append) + 1;
	str = realloc(str, length * sizeof(char));
	str = strcat(str, append);
	return str;
}

void log(Scheme *sc, char* module, char* method) {
	char* msg = (char *) malloc(sizeof(char) * 2);
	msg[0] = '\0';

	if (sc->op != NULL) {
		msg = concatenate(msg, " [[[op]]]");
		msg = concatenate(msg, cell2str(sc, sc->op));
	}
	if (sc->args != NULL) {
		msg = concatenate(msg, " [[[args]]]");
		msg = concatenate(msg, cell2str(sc, sc->args));
	}
	if (sc->env != NULL) {
		msg = concatenate(msg, " [[[env]]]");
		msg = concatenate(msg, cell2str(sc, sc->env));
	}
	if (sc->code != NULL) {
		msg = concatenate(msg, " [[[code]]]");
		msg = concatenate(msg, cell2str(sc, sc->code));
	}
	if (sc->returnValue != NULL) {
		msg = concatenate(msg, " [[[returnValue]]]");
		msg = concatenate(msg, cell2str(sc, sc->returnValue));
	}
	msg = concatenate(msg, "\n");

	write_log2(module, method, msg);

    //right: " [[[op]]]#<Procedure>: $e0args [[[args]]]() [[[env]]]#<Environment> [[[code]]](#<[UNKNOWN]>: ask #<[UNKNOWN]>: z #<[UNKNOWN]>: YEAR) [[[returnValue]]]#<Closure>: "
    //wrong: " [[[op]]]#<Procedure>: $e0args [[[args]]]() [[[env]]]#<Environment> [[[code]]](#<[UNKNOWN]>: ask #<[UNKNOWN]>: abc #<[UNKNOWN]>: YEAR) [[[returnValue]]]#<Closure>: "
}